Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PAS_0693/IO.PAS

Pascal/Delphi Source File | 1993-06-30 | 13KB | 494 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 360 of 375
From : Steve Gabrilowitz                   1:363/1701.0         30 May 93  01:25
To   : Simon Williamson
Subj : PASCAL AND FOSSIL DRIV
────────────────────────────────────────────────────────────────────────────────

In a message to Steve Gabrilowitz <05-26-93 18:37> Simon Williamson wrote:

SW>   > SW>  I was wondering if anyone had any routines they could send me
SW>   > or tell
SW>   > SW>  me where to find some routines that show you have to use the
SW>   > fossil
SW>   > I have a file on my BBS called TPIO_100.ZIP, I think it's just what
SW>   > you're  looking for!
SW>  Sounds good. One Problem! Your In USA and im in AUstralia! ANy chance
SW>  of attaching it to a message or is it too large? WIll have a look

It's not all that large, I guess I can put it into a message:}

Unit IO;

              { FOSSIL communications I/O routines }
              { Turbo Pascal Version by Tony Hsieh }

  {}{}{}{ Copyright (c) 1989 by Tony Hsieh, All Rights Reserved. }{}{}{}


{ The following routines are basic input/output routines, using a }
{ fossil driver.  These are NOT all the routines that a fossil    }
{ driver can do!  These are just a portion of the functions that  }
{ fossil drivers can do.  However, these are the only ones most   }
{ people will need.  I highly recommend for those that use this   }
{ to download an arced copy of the X00.SYS driver.  In the arc    }
{ is a file called "FOSSIL.DOC", which is where I derived my      }
{ routines from.  If there are any routines that you see are not  }
{ implemented here, use FOSSIL.DOC to add/make your own!  I've    }
{ listed enough examples here for you to figure out how to do it  }
{ yourself.                                                       }
{ This file was written as a unit for Turbo Pascal v4.0.  You     }
{ should compile it to DISK, and then in your own program type    }
{ this right after your program heading (before Vars and Types)   }
{ this: "uses IO;"                                                }
{ EXAMPLE: }
{

Program Communications;

uses IO;

begin
  InitializeDriver;
  Writeln ('Driver is initalized!');
  ModemSettings (1200,8,'N',1); Baud := 1200;
  DTR (0); Delay (1000); DTR (1);
  Writeln ('DTR is now true!');
  CloseDriver;
  Writeln ('Driver is closed!');
end.

}

{ Feel free to use these routines in your programs; copy this  }
{ file freely, but PLEASE DO NOT MODIFY IT.  If you do use     }
{ these routines in your program, please give proper credit to }
{ the author.                                                  }
{                                                              }
{ Thanks, and enjoy!                                           }
{                                                              }
{ Tony Hsieh                                                   }




INTERFACE

uses DOS;
                                       { These are communications routines }
                                       { that utilize a FOSSIL driver.  A  }
                                       { FOSSIL driver MUST be installed,  }
                                       { such as X00.SYS and OPUS!COM...   }

type
  String255 = String [255];

var
  Port: Integer;                 { I decided to make 'Port' a global    }
                                 { variable to make life easier.        }

  Baud: Word;                    { Same with Baud                       }

  RegistersRecord: Registers;    { DOS registers AX, BX, CX, DX, and Flags }


procedure BlankRegisters;
procedure ModemSettings (Baud, DataBits: Integer; Parity: Char;
                         Stopbits: Integer);
procedure InitializeDriver;
procedure CloseDriver;
procedure ReadKeyAhead (var First, Second: Char);
function ReceiveAhead (var Character: CHAR): Boolean;
function Online: boolean;
procedure DTR (DTRState: Integer);
procedure Reboot;
procedure BiosScreenWrite (Character: CHAR);
procedure WatchDog (INPUT: Boolean);
procedure WhereCursor (var Row: Integer; var Column: Integer);
procedure MoveCursor (Row: Integer; Column: Integer);
procedure KillInputBuffer;
procedure KillOutputBuffer;
procedure FlushOutput;
function InputAvailable: Boolean;
function OutputOkay: Boolean;
procedure ReceiveCharacter (var Character: CHAR);
procedure TransmitCharacter (Character: CHAR; var Status: Integer);
procedure FlowControl (Control: Boolean);
procedure CharacterOut (Character: CHAR);
procedure StringOut (Message: String255);
procedure LineOut (Message: String255);
procedure CrOut;


IMPLEMENTATION

procedure BlankRegisters;
begin
  Fillchar (RegistersRecord, SizeOf (RegistersRecord), 0);
end;

procedure ModemSettings (Baud, DataBits: Integer; Parity: Char;
                         StopBits: Integer);
                                               { Do this after initializing }
                                               { the FOSSIL driver and also }
                                               { when somebody logs on      }
var
  GoingOut: Integer;
begin
  GoingOut := 0;
  Case Baud of
      0 : Exit;
    100 : GoingOut := GoingOut + 000 + 00 + 00;
    150 : GoingOut := GoingOut + 000 + 00 + 32;
    300 : GoingOut := GoingOut + 000 + 64 + 00;
    600 : GoingOut := GoingOut + 000 + 64 + 32;
    1200: GoingOut := GoingOut + 128 + 00 + 00;
    2400: GoingOut := GoingOut + 128 + 00 + 32;
    4800: GoingOut := GoingOut + 128 + 64 + 00;
    9600: GoingOut := GoingOut + 128 + 64 + 32;
  end;
  Case DataBits of
    5: GoingOut := GoingOut + 0 + 0;
    6: GoingOut := GoingOut + 0 + 1;
    7: GoingOut := GoingOut + 2 + 0;
    8: GoingOut := GoingOut + 2 + 1;
  end;
  Case Parity of
    'N'    : GoingOut := GoingOut + 00 + 0;
    'O','o': GoingOut := GoingOut + 00 + 8;
    'n'    : GoingOut := GoingOut + 16 + 0;
    'E','e': GoingOut := GoingOut + 16 + 8;
  end;
  Case StopBits of
    1: GoingOut := GoingOut + 0;
    2: GoingOut := GoingOut + 4;
  end;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 0; AL := GoingOut;
    DX := (Port);
    Intr ($14, RegistersRecord);
  end;
end;

procedure InitializeDriver;                         { Do this before doing }
begin                                               { any IO routines!!!   }
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 4;
    DX := (Port);
    Intr ($14, RegistersRecord);
    If AX <> $1954 then
    begin
      Writeln ('* FOSSIL DRIVER NOT RESPONDING!  OPERATION HALTED!');
      halt (1);
    end;
  end;
end;

procedure CloseDriver;  { Run this after all I/O routines are done with }
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 5;
    DX := (Port);
    Intr ($14, RegistersRecord);
  end;
  BlankRegisters;
end;

procedure ReadKeyAhead (var First, Second: Char); { This procedure is via  }
                                                  { the FOSSIL driver, not }
                                                  { DOS!                   }
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := $0D;
    Intr ($14,RegistersRecord);
    First := chr(lo(AX));
    Second := chr(hi(AX));
  end;
end;

function ReceiveAhead (var Character: CHAR): Boolean;  { Non-destructive }
begin
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := $0C;
    DX := Port;
    Intr ($14,RegistersRecord);
    Character := CHR (AL);
    ReceiveAhead := AX <> $FFFF;
  end;
end;

function OnLine: Boolean;
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 3;
    DX := (Port);
    Intr ($14, RegistersRecord);
    OnLine := ((AL AND 128) = 128);
  end;
end;

procedure DTR (DTRState: Integer);    { 1=ON, 0=OFF }
                                      { Be sure that the modem dip switches }
                                      { are set properly... when DTR is off }
                                      { it usually drops carrier if online  }
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 6;
    DX := (Port);
    AL := DTRState;
    Intr ($14, RegistersRecord);
  end;
end;

procedure Reboot;                  { For EXTREME emergencies... Hmmm... }
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 23;
    AL := 1;
    Intr ($14, RegistersRecord);
  end;
end;

{       This is ANSI Screen Write via Fossil Driver }
{
procedure ANSIScreenWrite (Character: CHAR);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 19;
    AL := ORD (Character);
    Intr ($14, RegistersRecord);
  end;
end;
}

{ This is ANSI Screen Write via DOS! }

procedure ANSIScreenWrite (Character: CHAR);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 2;
    DL := ORD (Character);
    Intr ($21, RegistersRecord);
  end;
end;


procedure BIOSScreenWrite (Character: CHAR); { Through the FOSSIL driver }
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 21;
    AL := ORD (Character);
    Intr ($14, RegistersRecord);
  end;
end;

procedure WatchDog (INPUT: Boolean);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 20;
    DX := Port;
    Case INPUT of
      TRUE:  AL := 1;
      FALSE: AL := 0;
    end;
    Intr ($14, RegistersRecord);
  end;
end;

procedure WhereCursor (var Row: Integer; var Column: Integer);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 18;
    Intr ($14, RegistersRecord);
    Row := DH;
    Column := DL;
  end;
end;

procedure MoveCursor (Row: Integer; Column: Integer);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 17;
    DH := Row;
    DL := Column;
    Intr ($14, RegistersRecord);
  end;
end;

procedure KillInputBuffer;   { Kills all remaining input that has not been }
                             { read in yet }
begin
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 10;
    DX := Port;
    Intr ($14, RegistersRecord);
  end;
end;

procedure KillOutputBuffer;  { Kills all pending output that has not been }
                             { send yet }
begin
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 9;
    DX := Port;
    Intr ($14, RegistersRecord);
  end;
end;

procedure FlushOutput;       { Flushes the output buffer }
begin
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 8;
    DX := Port;
    Intr ($14, RegistersRecord);
  end;
end;

function InputAvailable: Boolean;   { Returns true if there's input }
                                    { from the modem.               }
begin
  InputAvailable := False;
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 3;
    DX := Port;
    Intr ($14, RegistersRecord);
    InputAvailable := ((AH AND 1) = 1);
  end;
end;

function OutputOkay: Boolean;     { Returns true if output buffer isn't full }
begin
  OutputOkay := True;
  If Baud=0 then exit;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 3;
    DX := Port;
    Intr ($14, RegistersRecord);
    OutputOkay := ((AH AND 32) = 32);
  end;
end;

procedure ReceiveCharacter (var Character: CHAR);   { Takes a character }
                                                    { out of the input  }
                                                    { buffer }
begin
  Character := #0;
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 2;
    DX := Port;
    Intr ($14, RegistersRecord);
    Character := CHR (AL);
  end;
end;

procedure TransmitCharacter (Character: CHAR; var Status: Integer);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 1;
    DX := Port;
    AL := ORD (Character);
    Intr ($14, RegistersRecord);
    Status := AX;        { Refer to FOSSIL.DOC about the STATUS var }
  end;
end;

procedure FlowControl (Control: Boolean);
begin
  BlankRegisters;
  With RegistersRecord do
  begin
    AH := 15;
    DX := Port;
    Case Control of
  TRUE:  AL := 255;
  FALSE: AL := 0;
    end;
    Intr ($14, RegistersRecord);
  end;
end;

procedure CharacterOut (Character: CHAR);
var
  Status: INTEGER;
begin
  { If SNOOP is on then }
    ANSIScreenWrite (Character);
  TransmitCharacter (Character, Status);
end;

procedure StringOut (Message: String255);
var
  CharPos: Byte;
begin
  CharPos := 0;
  If Length(Message) <> 0 then
  begin
    Repeat
      If NOT Online then exit;
      CharPos := CharPos + 1;
      CharacterOut (Message [CharPos]);
    Until CharPos = Length (Message);
  end;
end;

procedure LineOut (Message: String255);
begin
  StringOut (Message);
  CharacterOut (#13);
  CharacterOut (#10);
end;

procedure CrOut; { Outputs a carriage return and a line feed }
begin
  CharacterOut (#13);
  CharacterOut (#10);
end;

end.